VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ChanWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Private Declare Function SetScrollRange Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal bRedraw As Long) As Long
Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long


Private Const SB_LINEDOWN = 1

Private Declare Function SetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long


Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source


Private Const MM_LOENGLISH = 4



Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type RECT
        Left As Long
        TOP As Long
        Right As Long
        Bottom As Long
End Type

Public OwnerForm As Form
Rem ------ Window Stuff
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function DeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long, ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ScrollWindow Lib "user32" (ByVal hwnd As Long, ByVal XAmount As Long, ByVal YAmount As Long, lpRect As RECT, lpClipRect As RECT) As Long
Private Declare Function LPtoDP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function DPtoLP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long







Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOMOVE = &H2
Rem ------ Window Stuff

Rem ---- Form Moveing Api Calls
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal Wparam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONDBLCLK = &HA3
Private Const WM_SETHOTKEY = &H32
Private Const HTCAPTION = 2
Rem ---- Form Moveing Api Calls


Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As RECT, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Const TA_CENTER = 6
Private Const ETO_OPAQUE = 2
Private Const ETO_GRAYED = 1
Private Const ETO_CLIPPED = 4

Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Private Type Size
        cx As Long
        cy As Long
End Type

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long
Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Rem ------- Edge
Private Declare Function ScrollDC Lib "user32" (ByVal hdc As Long, ByVal dx As Long, ByVal dy As Long, lprcScroll As RECT, lprcClip As RECT, ByVal hrgnUpdate As Long, lprcUpdate As RECT) As Long


Private Const RDW_UPDATENOW = &H100

Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENINNER = &H8

Private Const BDR_OUTER = &H3
Private Const BDR_INNER = &HC
Private Const BDR_RAISED = &H5
Private Const BDR_SUNKEN = &HA

Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)

Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8

Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Const BF_DIAGONAL = &H10

' For diagonal lines, the BF_RECT flags specify the end point of
' the vector bounded by the rectangle parameter.
Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)

Private Const BF_MIDDLE = &H800    ' Fill in the middle.
Private Const BF_SOFT = &H1000     ' Use for softer buttons.
Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
Private Const BF_MONO = &H8000     ' For monochrome borders.
Rem --edge
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long


Private Declare Function Chord Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Buffer(100000) As String



Sub Printf3(txt As String, ByVal Xpos As Long, ByVal Ypos As Long, hdc As Long, Color As Long, bkC As Long, Trns As Boolean)
Dim R As RECT
Dim Sz As Size
SetTextColor hdc, Color
SetBkColor hdc, bkC
Linc = Ypos
R.TOP = Xpos
For X = 1 To Len(txt)
GetTextExtentPoint hdc, Mid(txt, X, 1), 1, Sz

R.Left = Linc
R.Right = Linc + Sz.cx
R.Bottom = R.TOP + Sz.cy
If Trns = False Then ExtTextOut hdc, R.Left, R.TOP, ETO_OPAQUE, R, Mid(txt, X, 1), 1, 0
If Trns = True Then ExtTextOut hdc, R.Left, R.TOP, ETO_CLIPPED, R, Mid(txt, X, 1), 1, 0
Linc = Linc + Sz.cx
'ExtTextOut hdc, r.Left, r.Top, ETO_CLIPPED, r, txt, 1, 0
'(&rc, 90, 190, 250, 220);
Next X
End Sub





Function Get_Metric(txt As String) As Long
Dim S As Size
X = GetTextExtentPoint(OwnerForm.hdc, txt, 1, S)
Get_Metric = S.cx
End Function

Function get_Metheight(txt As String) As Long
Dim S As Size
X = GetTextExtentPoint(OwnerForm.hdc, txt, 1, S)
get_Metheight = S.cy

End Function
Sub ScrWindowup(frm As Form, Am As Long)


'BitBlt OwnerForm.hdc, frm.ScaleLeft, frm.ScaleHeight, frm.ScaleWidth, frm.ScaleHeight, frm.hdc, frm.ScaleTop, frm.ScaleLeft, 0



Dim Scrollrect As RECT
Dim ClipREct As RECT
Scrollrect.TOP = frm.ScaleTop
Scrollrect.Bottom = frm.ScaleHeight
Scrollrect.Left = frm.ScaleLeft
Scrollrect.Right = frm.ScaleWidth

ScrollWindow frm.hwnd, 0, -Am, Scrollrect, Scrollrect


End Sub

Sub ScrWindowdw(frm As Form)
Dim Scrollrect As RECT
Dim ClipREct As RECT
Scrollrect.TOP = frm.ScaleTop
Scrollrect.Bottom = frm.ScaleHeight
Scrollrect.Left = Form1.ScaleLeft
Scrollrect.Right = Form1.ScaleWidth
ScrollWindow frm.hwnd, 0, 15, Scrollrect, Scrollrect


End Sub
Sub Refresh()
'OwnerForm.Cls
'Dim T As Long
'For T = 1 To BC
'Out Buffer(T)
'Next T
End Sub
Function Out(data As String) As Long
BC = BC + 1: Buffer(BC) = data

Dim Xt As Long

Dim Linc As Long, Tinc As Long

Dim CCODE As Long
Dim FCode As Long
Dim Scount As Long
Dim TMPD As String

CCODE = RGB(0, 0, 0)
FCode = RGB(255, 255, 255)
'Tinc = Form1.ScaleHeight - OwnerForm.FontSize
Linc = 1



For Xt = 1 To Len(data)  '/The Loop starts here!
St:


TMPD = Mid(data, Xt, 1)

'und
If TMPD = "" Then
Debug.Print "Changing Underline"
Xt = Xt + 1
If OwnerForm.FontUnderline = True Then OwnerForm.FontUnderline = False: GoTo St
If OwnerForm.FontUnderline = False Then OwnerForm.FontUnderline = True: GoTo St
End If


Rem ------------------ BOLD --------
If TMPD = "" Then
Debug.Print "Changing BOLD"
Xt = Xt + 1
If OwnerForm.FontBold = True Then OwnerForm.FontBold = False: GoTo St
If OwnerForm.FontBold = False Then OwnerForm.FontBold = True: GoTo St
End If

'Debug.Print Chr(1)
If TMPD = "" Then Xt = Xt + 1: Debug.Print "Reseting Colors": GoTo St
If TMPD = "" Then Xt = Xt + 1: Debug.Print "Handling Reverse": GoTo St


If TMPD = "" Then
Xt = Xt + 1



Dim tmp As String
tmp = Mid(data, Xt, 2)

If Isnum(tmp) = True Then Fg = tmp: GoTo Calc

If Isnum(Mid(tmp, 1, 1)) = True Then Fg = Mid(tmp, 1, 1): GoTo Calc
Fg = "": GoTo St

Calc:
Xt = Xt + Len(Fg)





If Mid(data, Xt, 1) = "," Then
Dim tmp2 As String
Xt = Xt + 1
tmp2 = Trim(Mid(data, Xt, 2))

If Isnum(tmp2) = False Then tmp2 = Mid(tmp2, 1, 1)


Xt = Xt + Len(tmp2)
GoTo St

Else
GoTo St
End If


End If



Dt:

Scount = Scount + 1
If tmp <> "" Then FCode = ret_Color(Val(tmp))
If tmp2 <> "" Then CCODE = ret_Color(Val(tmp2))


STRIP = STRIP + TMPD

Rem --- Virtual Sizer
Tmetric = Me.Get_Metric(TMPD)

If Linc + Tmetric * 2 > OwnerForm.ScaleWidth Then Linc = 0: Me.ScrWindowup OwnerForm, 15

Printf3 TMPD, OwnerForm.ScaleHeight - 35, Linc, OwnerForm.hdc, FCode, CCODE, True
Linc = Linc + Tmetric:



Next Xt


End Function

Function Isnum(S As String) As Boolean
Dim X As Long
For X = 0 To 15
If CStr(X) = S Then Isnum = True: Exit Function
Next X
Isnum = False
End Function





Function ret_Color(CCODE As Long) As Long
If CCODE = 0 Then ret_Color = RGB(255, 255, 255)
If CCODE = 1 Then ret_Color = 0:
If CCODE = 2 Then ret_Color = RGB(0, 0, 155)
If CCODE = 3 Then ret_Color = RGB(0, 150, 0)
If CCODE = 4 Then ret_Color = RGB(200, 0, 0)
If CCODE = 5 Then ret_Color = RGB(127, 0, 0)
If CCODE = 6 Then ret_Color = RGB(156, 0, 156)
If CCODE = 7 Then ret_Color = RGB(252, 127, 0)
If CCODE = 8 Then ret_Color = QBColor(14)
If CCODE = 9 Then ret_Color = RGB(0, 255, 0)
If CCODE = 10 Then ret_Color = RGB(0, 147, 147)
If CCODE = 11 Then ret_Color = RGB(0, 255, 255)
If CCODE = 12 Then ret_Color = RGB(0, 0, 255)
If CCODE = 13 Then ret_Color = RGB(255, 0, 255)
If CCODE = 14 Then ret_Color = RGB(155, 155, 155)
If CCODE = 15 Then ret_Color = RGB(255, 255, 255)


End Function

Private Sub Class_Initialize()
'SetScrollRange OwnerForm.hwnd, 1, 1, 500, 1
'ShowScrollBar OwnerForm.hwnd, 1, 1
'SetScrollPos OwnerForm.hwnd, 1, 1, 1
End Sub


